indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.1.1 v dplyr 1.0.6
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 385)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 13.05507 13.05018 13.04535 13.04059 13.03590 13.03127 13.02670 13.02219
## [9] 13.01774 13.01335 13.00902 13.00474 13.00051 12.99634 12.99222 12.98814
## [17] 12.98411 12.98013 12.97620 12.97230 12.96845 12.96464 12.96087 12.95713
## [25] 12.95343 12.94976 12.94613 12.94253 12.93895 12.93541 12.93189 12.92840
## [33] 12.92493 12.92148 12.91806 12.91465 12.91127 12.90792 12.90461 12.90133
## [41] 12.89809 12.89489 12.89173 12.88861 12.88553 12.88250 12.87952 12.87659
## [49] 12.87371 12.87088 12.86811 12.86539 12.86273 12.86013 12.85759 12.85512
## [57] 12.85271 12.85036 12.84809 12.84588 12.84375 12.84169 12.83970 12.83779
## [65] 12.83596 12.83421 12.83254 12.83095 12.82945 12.82804 12.82672 12.82545
## [73] 12.82423 12.82304 12.82189 12.82079 12.81972 12.81870 12.81773 12.81679
## [81] 12.81591 12.81507 12.81428 12.81355 12.81286 12.81223 12.81165 12.81113
## [89] 12.81066 12.81025 12.80990 12.80962 12.80939 12.80922 12.80912 12.80909
## [97] 12.80912 12.80921 12.80938 12.80962 12.80993 12.81031 12.81076 12.81129
## [105] 12.81190 12.81258 12.81334 12.81418 12.81511 12.81611 12.81720 12.81837
## [113] 12.81963 12.82113 12.82299 12.82519 12.82771 12.83053 12.83360 12.83692
## [121] 12.84046 12.84418 12.84806 12.85208 12.85622 12.86044 12.86472 12.86903
## [129] 12.87336 12.87767 12.88194 12.88614 12.89025 12.89425 12.89809 12.90177
## [137] 12.90526 12.90852 12.91154 12.91429 12.91793 12.92351 12.93083 12.93970
## [145] 12.94990 12.96125 12.97353 12.98655 13.00010 13.01399 13.02802 13.04198
## [153] 13.05568 13.06891 13.08147 13.09316 13.10378 13.11314 13.12102 13.12723
## [161] 13.13157 13.13592 13.14215 13.15006 13.15942 13.17001 13.18162 13.19404
## [169] 13.20704 13.22041 13.23393 13.24739 13.26057 13.27325 13.28522 13.29626
## [177] 13.30615 13.31468 13.32163 13.32678 13.32992 13.33084 13.33042 13.32973
## [185] 13.32874 13.32747 13.32588 13.32399 13.32177 13.31923 13.31636 13.31314
## [193] 13.30957 13.30565 13.30136 13.29670 13.29166 13.28623 13.28040 13.27417
## [201] 13.26754 13.26048 13.25300 13.24508 13.23672 13.22791 13.21865 13.20892
## [209] 13.19873 13.18805 13.17530 13.15917 13.14012 13.11857 13.09496 13.06974
## [217] 13.04332 13.01617 12.98870 12.96136 12.93458 12.90881 12.88448 12.86203
## [225] 12.84189 12.82450 12.80726 12.78747 12.76539 12.74128 12.71541 12.68804
## [233] 12.65944 12.62987 12.59959 12.56888 12.53798 12.50718 12.47674 12.44691
## [241] 12.41796 12.39016 12.36378 12.33907 12.31630 12.29574 12.27765 12.26103
## [249] 12.24467 12.22858 12.21273 12.19713 12.18176 12.16660 12.15165 12.13690
## [257] 12.12233 12.10794 12.09371 12.07963 12.06570 12.05189 12.03821 12.02464
## [265] 12.01117 11.99778 11.98534 11.97459 11.96537 11.95754 11.95093 11.94539
## [273] 11.94075 11.93687 11.93358 11.93073 11.92815 11.92570 11.92322 11.92055
## [281] 11.91752 11.91399 11.90980 11.90479 11.89880 11.89168 11.88326 11.87410
## [289] 11.86486 11.85557 11.84623 11.83689 11.82754 11.81823 11.80896 11.79976
## [297] 11.79064 11.78164 11.77277 11.76406 11.75552 11.74717 11.73904 11.73074
## [305] 11.72193 11.71267 11.70304 11.69311 11.68295 11.67263 11.66224 11.65183
## [313] 11.64148 11.63126 11.62125 11.61152 11.60214 11.59317 11.58471 11.57680
## [321] 11.56954 11.56299 11.55721 11.55230 11.54784 11.54343 11.53907 11.53479
## [329] 11.53060 11.52652 11.52257 11.51876 11.51513 11.51168 11.50843 11.50541
## [337] 11.50262 11.50009 11.49784 11.49588 11.49424 11.49293 11.49197 11.49127
## [345] 11.49075 11.49041 11.49025 11.49027 11.49049 11.49090 11.49151 11.49232
## [353] 11.49335 11.49458 11.49604 11.49771 11.49961 11.50174 11.50411 11.50671
## [361] 11.50956 11.51266 11.51601 11.51961 11.52354 11.52786 11.53255 11.53760
## [369] 11.54300 11.54874 11.55480 11.56116 11.56782 11.57477 11.58199 11.58947
## [377] 11.59719 11.60514 11.61332 11.62170 11.63028 11.63904 11.64796 11.65705
## [385] 11.66628#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 385)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.60505 12.60120 12.59743 12.59373 12.59011 12.58657 12.58310 12.57971
## [9] 12.57640 12.57316 12.57000 12.56692 12.56391 12.56098 12.55813 12.55535
## [17] 12.55265 12.55003 12.54748 12.54501 12.54261 12.54029 12.53805 12.53588
## [25] 12.53379 12.53177 12.52983 12.52797 12.52618 12.52447 12.52283 12.52127
## [33] 12.51979 12.51838 12.51704 12.51578 12.51460 12.51350 12.51248 12.51153
## [41] 12.51067 12.50988 12.50917 12.50855 12.50800 12.50753 12.50714 12.50683
## [49] 12.50660 12.50645 12.50637 12.50638 12.50647 12.50664 12.50689 12.50721
## [57] 12.50762 12.50811 12.50868 12.50932 12.51005 12.51086 12.51175 12.51272
## [65] 12.51377 12.51490 12.51611 12.51740 12.51878 12.52023 12.52176 12.52338
## [73] 12.52507 12.52685 12.52871 12.53065 12.53267 12.53477 12.53703 12.53950
## [81] 12.54217 12.54505 12.54813 12.55139 12.55483 12.55844 12.56222 12.56615
## [89] 12.57024 12.57447 12.57883 12.58332 12.58793 12.59266 12.59749 12.60242
## [97] 12.60744 12.61255 12.61773 12.62298 12.62829 12.63366 12.63907 12.64453
## [105] 12.65001 12.65553 12.66105 12.66659 12.67214 12.67768 12.68320 12.68871
## [113] 12.69419 12.69964 12.70505 12.71040 12.71571 12.72095 12.72612 12.73121
## [121] 12.73669 12.74296 12.74995 12.75754 12.76567 12.77422 12.78311 12.79225
## [129] 12.80155 12.81091 12.82024 12.82945 12.83845 12.84715 12.85545 12.86327
## [137] 12.87051 12.87708 12.88289 12.88784 12.89315 12.89997 12.90813 12.91748
## [145] 12.92785 12.93907 12.95099 12.96343 12.97625 12.98926 13.00231 13.01524
## [153] 13.02787 13.04006 13.05163 13.06242 13.07227 13.08101 13.08848 13.09452
## [161] 13.09897 13.10370 13.11057 13.11934 13.12974 13.14155 13.15451 13.16838
## [169] 13.18292 13.19788 13.21302 13.22809 13.24285 13.25706 13.27046 13.28282
## [177] 13.29389 13.30342 13.31118 13.31691 13.32038 13.32133 13.32033 13.31814
## [185] 13.31481 13.31042 13.30502 13.29866 13.29142 13.28336 13.27452 13.26499
## [193] 13.25481 13.24404 13.23275 13.22101 13.20886 13.19637 13.18360 13.17061
## [201] 13.15747 13.14422 13.13095 13.11770 13.10453 13.09151 13.07870 13.06616
## [209] 13.05395 13.04213 13.02829 13.01036 12.98891 12.96449 12.93766 12.90899
## [217] 12.87902 12.84833 12.81747 12.78700 12.75748 12.72948 12.70354 12.68024
## [225] 12.66013 12.64377 12.62859 12.61177 12.59349 12.57392 12.55326 12.53168
## [233] 12.50935 12.48647 12.46320 12.43974 12.41625 12.39292 12.36993 12.34746
## [241] 12.32569 12.30479 12.28496 12.26636 12.24919 12.23361 12.21981 12.20757
## [249] 12.19648 12.18643 12.17730 12.16897 12.16134 12.15428 12.14769 12.14146
## [257] 12.13546 12.12959 12.12373 12.11776 12.11158 12.10507 12.09812 12.09061
## [265] 12.08243 12.07346 12.06510 12.05870 12.05405 12.05098 12.04928 12.04877
## [273] 12.04925 12.05055 12.05246 12.05479 12.05735 12.05996 12.06241 12.06453
## [281] 12.06612 12.06698 12.06693 12.06578 12.06333 12.05940 12.05379 12.04710
## [289] 12.04009 12.03279 12.02525 12.01751 12.00962 12.00161 11.99353 11.98543
## [297] 11.97734 11.96931 11.96138 11.95359 11.94599 11.93862 11.93152 11.92441
## [305] 11.91702 11.90936 11.90148 11.89339 11.88514 11.87676 11.86827 11.85971
## [313] 11.85110 11.84249 11.83389 11.82535 11.81689 11.80855 11.80035 11.79233
## [321] 11.78452 11.77694 11.76964 11.76264 11.75577 11.74886 11.74190 11.73491
## [329] 11.72790 11.72086 11.71381 11.70675 11.69970 11.69265 11.68561 11.67859
## [337] 11.67160 11.66465 11.65773 11.65086 11.64405 11.63729 11.63061 11.62395
## [345] 11.61728 11.61060 11.60391 11.59723 11.59054 11.58387 11.57721 11.57056
## [353] 11.56393 11.55732 11.55075 11.54420 11.53769 11.53122 11.52479 11.51842
## [361] 11.51209 11.50582 11.49960 11.49346 11.48742 11.48155 11.47583 11.47024
## [369] 11.46479 11.45945 11.45423 11.44910 11.44407 11.43911 11.43422 11.42939
## [377] 11.42461 11.41988 11.41517 11.41048 11.40580 11.40112 11.39644 11.39173
## [385] 11.38699#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 385)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 12.05954 12.05262 12.04582 12.03913 12.03254 12.02606 12.01969 12.01343
## [9] 12.00726 12.00120 11.99524 11.98938 11.98361 11.97795 11.97238 11.96690
## [17] 11.96152 11.95622 11.95102 11.94591 11.94088 11.93594 11.93109 11.92631
## [25] 11.92163 11.91702 11.91249 11.90804 11.90367 11.89937 11.89515 11.89100
## [33] 11.88692 11.88291 11.87897 11.87510 11.87130 11.86756 11.86389 11.86027
## [41] 11.85672 11.85323 11.84980 11.84645 11.84321 11.84007 11.83705 11.83413
## [49] 11.83132 11.82862 11.82602 11.82353 11.82115 11.81887 11.81670 11.81464
## [57] 11.81268 11.81084 11.80909 11.80745 11.80592 11.80450 11.80318 11.80196
## [65] 11.80086 11.79985 11.79895 11.79816 11.79747 11.79689 11.79641 11.79604
## [73] 11.79577 11.79560 11.79554 11.79559 11.79573 11.79598 11.79628 11.79656
## [81] 11.79685 11.79713 11.79742 11.79772 11.79804 11.79839 11.79878 11.79920
## [89] 11.79966 11.80018 11.80075 11.80139 11.80209 11.80287 11.80374 11.80469
## [97] 11.80573 11.80687 11.80812 11.80948 11.81096 11.81257 11.81430 11.81617
## [105] 11.81819 11.82035 11.82267 11.82515 11.82779 11.83061 11.83361 11.83680
## [113] 11.84018 11.84375 11.84753 11.85152 11.85573 11.86016 11.86481 11.86971
## [121] 11.87528 11.88189 11.88946 11.89788 11.90707 11.91692 11.92733 11.93822
## [129] 11.94948 11.96102 11.97274 11.98455 11.99635 12.00804 12.01953 12.03073
## [137] 12.04153 12.05183 12.06156 12.07060 12.08095 12.09446 12.11081 12.12968
## [145] 12.15074 12.17367 12.19816 12.22388 12.25051 12.27772 12.30521 12.33264
## [153] 12.35969 12.38605 12.41139 12.43540 12.45774 12.47810 12.49616 12.51160
## [161] 12.52409 12.53659 12.55203 12.57008 12.59039 12.61263 12.63644 12.66149
## [169] 12.68743 12.71393 12.74063 12.76721 12.79332 12.81860 12.84274 12.86537
## [177] 12.88617 12.90478 12.92086 12.93408 12.94410 12.95056 12.95432 12.95650
## [185] 12.95719 12.95646 12.95439 12.95106 12.94655 12.94093 12.93429 12.92669
## [193] 12.91823 12.90897 12.89900 12.88840 12.87723 12.86559 12.85354 12.84118
## [201] 12.82857 12.81579 12.80292 12.79005 12.77724 12.76458 12.75214 12.74001
## [209] 12.72826 12.71696 12.70345 12.68538 12.66339 12.63807 12.61004 12.57991
## [217] 12.54830 12.51581 12.48307 12.45068 12.41926 12.38941 12.36176 12.33691
## [225] 12.31548 12.29808 12.28188 12.26378 12.24399 12.22269 12.20009 12.17639
## [233] 12.15177 12.12645 12.10062 12.07447 12.04820 12.02202 11.99611 11.97069
## [241] 11.94594 11.92206 11.89926 11.87772 11.85765 11.83925 11.82271 11.80756
## [249] 11.79314 11.77939 11.76624 11.75362 11.74145 11.72967 11.71821 11.70699
## [257] 11.69595 11.68501 11.67412 11.66318 11.65215 11.64094 11.62949 11.61773
## [265] 11.60558 11.59298 11.58065 11.56931 11.55889 11.54929 11.54044 11.53225
## [273] 11.52464 11.51753 11.51083 11.50447 11.49835 11.49239 11.48652 11.48066
## [281] 11.47470 11.46859 11.46222 11.45553 11.44842 11.44082 11.43264 11.42415
## [289] 11.41569 11.40729 11.39896 11.39071 11.38258 11.37456 11.36668 11.35897
## [297] 11.35143 11.34409 11.33696 11.33006 11.32341 11.31702 11.31092 11.30479
## [305] 11.29834 11.29162 11.28468 11.27759 11.27038 11.26312 11.25586 11.24865
## [313] 11.24155 11.23461 11.22788 11.22142 11.21527 11.20950 11.20416 11.19930
## [321] 11.19497 11.19123 11.18813 11.18572 11.18367 11.18163 11.17961 11.17765
## [329] 11.17576 11.17397 11.17231 11.17079 11.16945 11.16831 11.16738 11.16671
## [337] 11.16630 11.16620 11.16641 11.16696 11.16788 11.16920 11.17093 11.17296
## [345] 11.17516 11.17754 11.18010 11.18286 11.18582 11.18899 11.19238 11.19599
## [353] 11.19984 11.20393 11.20827 11.21286 11.21773 11.22286 11.22828 11.23399
## [361] 11.23999 11.24630 11.25293 11.25987 11.26722 11.27502 11.28327 11.29194
## [369] 11.30103 11.31051 11.32037 11.33059 11.34116 11.35205 11.36326 11.37476
## [377] 11.38655 11.39859 11.41089 11.42341 11.43615 11.44909 11.46221 11.47550
## [385] 11.48893#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")